home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / soundpas.zip / PLAYER.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-20  |  8KB  |  253 lines
  1. program Player;
  2. {
  3.   Usage: Borland International Conference, 1993
  4.   Programmer: Charlie Calvert (CIS: 76711,533) (MCI: 531-8890)
  5.   Date: March, 1993
  6.   Status: Preliminary "Beta" Version ( See Details, below )
  7.  
  8.   Copyright (c) June 1993, by Charlie Calvert
  9.   Feel free to use this code as an adjunct to your own programs.
  10.  
  11.   This is the main module of the Player program, which uses
  12.   multimedia Windows calls to play CDs, MIDI files and WAV files.
  13.   You must have either a CD player or a Soundcard in order to use
  14.   this program.
  15.  
  16.   Before this program will compile and run correctly, the following
  17.   binary files must be present:
  18.  
  19.   Player.res    ( Player.rc and PlayerId.Pas )
  20.   CDInfo.dll    ( CDInfo.pas and PlayInfo.Pas )
  21.   MIDIInfo.dll  ( MIDIInfo.pas and PlayInfo.Pas )
  22.   WaveInfo.dll  ( WaveInfo.pas and PlayInfo.Pas )
  23.  
  24.   To create the above files, you can run BuildAll.bat from the
  25.   DOS prompt.
  26.  
  27.   Assuming the above binary files are already present, then
  28.   this module relies mainly on three units, each of which
  29.   contains a single TDialog descendant object:
  30.  
  31.   CdPlay        ( Play Cds )
  32.   MidiPlay      ( Play Midi Files )
  33.   WavePlay      ( Play Wave files )
  34.  
  35.   Each of the above listed objects serves as an interface to one of
  36.   the DLLs, which are of course written using conventional structured
  37.   programming techniques. The files CDUnit, MidiUnit and WaveUnit
  38.   declare the routines available in the DLLs.
  39.  
  40.   Status Details as of May 16, 1993: Though not yet totally polished
  41.   and complete, as is, this program gives you basic access to WAVE,
  42.   MIDI and CD-ROM files. Though I do check for obvious runtime
  43.   problems, serious error checking won't be added until I have a
  44.   relatively final code base. Updates of this program will appear
  45.   periodically on the Borland Download BBS (408)-438-9096, or
  46.   via Compuserve.
  47. }
  48.  
  49. uses
  50.   CDplay,
  51.   MidiPlay,
  52.   MmSystem,
  53.   ODialogs,
  54.   OWindows,
  55.   PlayerID,
  56.   Strings,
  57.   WavePlay,
  58.   WinTypes,
  59.   WinProcs;
  60.  
  61. {$R Player.Res}
  62.  
  63. const
  64.   MMTypes:array[0..10] of PChar = ('cdaudio', 'dat', 'digitalvideo',
  65.                                    'MMMovie', 'other', 'overlay',
  66.                                    'scanner', 'sequencer', 'vcr',
  67.                                    'videodisc', 'waveaudio');
  68.  
  69.   MMAbles:array[0..10] of PChar = ('Not Supported', 'Can Eject', 'Can Play',
  70.                                    'Can Pause', 'Can Stop', 'Can_Record',
  71.                                    'Can Save', 'Is Compound', 'Has Audio',
  72.                                    'Has Video', 'Uses Files');
  73.  
  74.   Tests:array[1..10] of LongInt = (Mci_GetDevCaps_Can_Eject,
  75.                                   Mci_GetDevCaps_Can_Play,
  76.                                   Mci_GetDevCaps_Can_Play,
  77.                                   Mci_GetDevCaps_Can_Play,
  78.                                   Mci_GetDevCaps_Can_Record,
  79.                                   Mci_GetDevCaps_Can_Save,
  80.                                   Mci_GetDevCaps_Compound_Device,
  81.                                   Mci_GetDevCaps_Has_Audio,
  82.                                   Mci_GetDevCaps_Has_Video,
  83.                                   Mci_GetDevCaps_Uses_Files);
  84.  
  85. type
  86.   TBox = array[0..10] of PCheckBox;
  87.   TButtons = array[0..10] of PButton;
  88.  
  89.   TMyApplication = object(TApplication)
  90.     procedure InitMainWindow; virtual;
  91.   end;
  92.  
  93.  
  94.   PPlayer = ^TPlayer;
  95.   TPlayer = object(TWindow)
  96.       AudioCheck: PCheckBox;
  97.     constructor Init(AParent: PWindowsObject; AName: PChar);
  98.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  99.     procedure CmCD(var Msg: TMessage);
  100.       virtual cm_First + cm_CD;
  101.     procedure CMMidi(var Msg: TMessage);
  102.       virtual cm_First + cm_Midi;
  103.     procedure CmWave(var Msg: TMessage);
  104.       virtual cm_First + cm_Wave;
  105.     procedure WmCommand(var Msg: TMessage);
  106.       virtual wm_First + wm_Command;
  107.   end;
  108.  
  109. var
  110.   Box: TBox;
  111.   BoxAble: TBox;
  112.   Buttons: TButtons;
  113. {--------------------------------------------------}
  114. { TPlayer's method implementations:                }
  115. {--------------------------------------------------}
  116.  
  117. constructor TPlayer.Init(AParent: PWindowsObject; AName: PChar);
  118. var
  119.   CheckBox: PCheckBox;
  120.   i: Integer;
  121. begin
  122.   inherited Init(AParent, AName);
  123.   Attr.Menu := LoadMenu(HInstance, 'MENU_1');
  124.   for i := 0 to 10 do begin
  125.     Buttons[i] := New(PButton, Init(@Self, 201 + i, '&Test', 250, 9 + (26 * i), 50, 20, False));
  126.     Box[i] := New(PCheckBox, Init(@Self, 101 + i, MMTypes[i], 325, 26 * i, 120, 35, nil));
  127.     BoxAble[i] := New(PCheckBox, Init(@Self, 2001 + i, MMAbles[i], 450, 26 * i, 120, 35, nil));
  128.   end;
  129. end;
  130.  
  131. procedure PrintInfo(PaintDC: HDC; Section, Title, SrchStr: PChar; Row: Byte);
  132. var
  133.   S: array[0..150] of Char;
  134.   Buf: PChar;
  135. begin
  136.   GetMem(Buf, 150);
  137.   GetPrivateProfileString(Section, Title, 'None', Buf, 150, 'System.Ini');
  138.   wvsprintf(S, SrchStr, Buf);
  139.   TextOut(PaintDC, 10, 10 * 2 * Row, S, StrLen(S));
  140.   FreeMem(Buf, 150);
  141. end;
  142.  
  143. procedure TestAbilities(HWindow: HWnd; id: LongInt; OldResult: LongInt);
  144. var
  145.   Info: TMCI_GetDevCaps_Parms;
  146.   i: Integer;
  147.   Result,
  148.   Flags: LongInt;
  149. begin
  150.   for i := 0 to 10 do SendMessage(BoxAble[i]^.HWindow, BM_SetCheck, 0, 0);
  151.   if OldResult <> 0 then begin
  152.     SendMessage(BoxAble[0]^.HWindow, BM_SetCheck, 1, 0);
  153.     Exit;
  154.   end;
  155.   for i := 1 to 10 do begin
  156.     FillChar(Info, SizeOf(Info), #0);
  157.     Info.dwItem := Tests[i];
  158.     Flags := Mci_GetDevCaps_Item or Mci_Notify;
  159.     Result := MciSendCommand(id, Mci_GetDevCaps, Flags, LongInt(@Info));
  160.     if Info.dwReturn > 0 then
  161.       SendMessage(BoxAble[i]^.HWindow, BM_SetCheck, 1, 0);
  162.   end;
  163. end;
  164.  
  165. function TestMCI(HWindow: HWnd; DeviceType: PChar; DoTest: Boolean): Boolean;
  166. var
  167.   OpenParms: TMci_Open_Parms;
  168.   Style: LongInt;
  169.   Result: LongInt;
  170.   S1: array [0..150] of Char;
  171. begin
  172.   TestMCI := True;
  173.   OpenParms.lpstrDeviceType := DeviceType;
  174.   Style := Mci_Open_Type;
  175.   Result := MciSendCommand(0, MCI_OPEN, Style, LongInt(@OpenParms));
  176.   if DoTest then
  177.     TestAbilities(HWindow, OpenParms.wDeviceId, Result);
  178.   if Result <> 0 then
  179.     TestMCI := False
  180.   else
  181.     MciSendCommand(OpenParms.wdeviceId, MCI_CLOSE, 0, 0);
  182. end;
  183.  
  184. procedure TPlayer.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  185. var
  186.   i: Integer;
  187. begin
  188.   SetBkMode(PaintDC, TRANSPARENT);
  189.   PrintInfo(PaintDC, 'Drivers', 'Timer', 'Timer: %s', 1);
  190.   PrintInfo(PaintDC, 'Drivers', 'MidiMapper', 'MidiMapper: %s', 2);
  191.   PrintInfo(PaintDC, 'Drivers', 'Wave', 'Wave: %s', 3);
  192.   PrintInfo(PaintDC, 'MCI', 'WaveAudio', 'MCI Wave: %s', 5);
  193.   PrintInfo(PaintDC, 'MCI', 'Sequencer', 'MCI Seq: %s', 6);
  194.   PrintInfo(PaintDC, 'MCI', 'CDAudio', 'MCI CD: %s', 7);
  195.  
  196.   for i := 0 to 10 do begin
  197.     if TestMCI(HWindow, MMTypes[i], False)then
  198.       SendMessage(Box[i]^.HWindow, BM_SetCheck, 1, 0);
  199.   end;
  200. end;
  201.  
  202. procedure TPlayer.CmCD(var Msg: TMessage);
  203. var
  204.   D: PCDDialog;
  205. begin
  206.   D := New(PCDDialog, Init(@Self, 'CdDlg'));
  207.   Application^.ExecDialog(D);
  208. end;
  209.  
  210. procedure TPlayer.CmMidi(var Msg: TMessage);
  211. var
  212.   D: PMidiDlg;
  213. begin
  214.   D := New(PMidiDlg, Init(@Self, 'MidiDlg'));
  215.   Application^.ExecDialog(D);
  216. end;
  217.  
  218. procedure TPlayer.CmWave(var Msg: TMessage);
  219. var
  220.   D: PWaveDlg;
  221. begin
  222.   D := New(PWaveDlg, Init(@Self, 'WaveDlg'));
  223.   Application^.ExecDialog(D);
  224. end;
  225.  
  226. procedure TPlayer.WmCommand(var Msg: TMessage);
  227. begin
  228.   if (Msg.WParam > 200) and (Msg.WParam < 300) then
  229.     TestMCI(HWindow, MMTypes[Msg.WParam - 201], True);
  230.   inherited WmCommand(Msg);
  231. end;
  232.  
  233. {--------------------------------------------------}
  234. { TMyApplication's method implementations:         }
  235. {--------------------------------------------------}
  236.  
  237. procedure TMyApplication.InitMainWindow;
  238. begin
  239.   MainWindow := New(PPlayer, Init(nil, 'Pascal CD Player'));
  240. end;
  241.  
  242. {--------------------------------------------------}
  243. { Main program:                                    }
  244. {--------------------------------------------------}
  245.  
  246. var
  247.   MyApp: TMyApplication;
  248.  
  249. begin
  250.   MyApp.Init('MyProgram');
  251.   MyApp.Run;
  252.   MyApp.Done;
  253. end.